www.gusucode.com > AspFaq在线帮助系统 V1.0 > AspFaq在线帮助系统 V1.0\code\edit\asp\upload.asp

    <%
'Option Explicit 
'(0)sStyleName,(1)sStyleInitMode,(2)sStyleFixWidth,(3)sStyleSkin,(4)sStyleWidth,(5)sStyleHeight,(6)sStyleStateFlag,(7)sStyleSBCode,(8)sStyleSBEdit,(9)sStyleSBText,(10)sStyleSBView,(11)sStyleDetectFromWord,(12)sStyleAutoRemote,(13)sStyleShowBorder,(14)sAutoDetectLanguage,(15)sDefaultLanguage,(16)sStyleEntermode,(17)sStyleMemo,(18)sStyleUploadObject,(19)sStyleAutoDir,(20)sStyleAllowBrowse,(21)sStyleCusDirFlag,(22)sStyleBaseUrl,(23)sStyleUploadDir,(24)sStyleBaseHref,(25)sStyleContentPath,(26)sStyleImageExt,(27)sStyleImageSize,(28)sStyleFlashExt,(29)sStyleFlashSize,(30)sStyleMediaExt,(31)sStyleMediaSize,(32)sStyleFileExt,(33)sStyleFileSize,(34)sStyleRemoteExt,(35)sStyleRemoteSize,(36)sStyleLocalExt,(37)sStyleLocalSize,(38)sSLTSYObject,(39)sSLTSYExt,(40)sSLTFlag,(41)sSLTMinSize,(42)sSLTOkSize,(43)sSYWZFlag,(44)sSYWZMinWidth,(45)sSYWZMinHeight,(46)sSYText,(47)sSYFontColor,(48)sSYShadowColor,(49)sSYShadowOffset,(50)sSYFontSize,(51)sSYFontName,(52)sSYWZPosition,(53)sSYWZpaddingh,(54)sSYWZpaddingv,(55)sSYWZtextWidth,(56)sSYWZtextHeight,(57)sSYTPFlag,(58)sSYTPMinWidth,(59)sSYTPMinHeight,(60)sSYTPPosition,(61)sSYTPPaddingh,(62)sSYTPPaddingv,(63)sSYPicPath,(64)sSYtpopacity,(65)sSYTPImageWidth,(66)sSYTPImageHeight,(67)sStyleAreaCssMode
'netbox不支持session.codepage
'Session("eWebEditor_Original_CodePage") = Session.CodePage
'Session.CodePage = 65001
%>
<!--#include file="config.asp"-->
<!--#include file="upfileclass.asp"-->

<%
Server.ScriptTimeOut = 1800

Dim sType, sStyleName, sCusDir
Dim sAllowExt, nAllowSize, sUploadDir, nUploadObject, nAutoDir, sBaseUrl, sContentPath
Dim sFileExt, sOriginalFileName, sSaveFileName, sPathFileName, nFileNum
Dim nSLTFlag, nSLTMinSize, nSLTOkSize, nSYWZFlag, sSYText, sSYFontColor, nSYFontSize, sSYFontName, sSYPicPath, nSLTSYObject, sSLTSYExt, nSYWZMinWidth, sSYShadowColor, nSYShadowOffset, nSYWZMinHeight, nSYWZPosition, nSYWZTextWidth, nSYWZTextHeight, nSYWZPaddingH, nSYWZPaddingV, nSYTPFlag, nSYTPMinWidth, nSYTPMinHeight, nSYTPPosition, nSYTPPaddingH, nSYTPPaddingV, nSYTPImageWidth, nSYTPImageHeight, nSYTPOpacity, nCusDirFlag
Dim bOutUrl

Call InitUpload()

Dim sAction
sAction = UCase(Trim(Request.QueryString("action")))

'Call DoCreateNewDir()

Select Case sAction
Case "REMOTE"
	Call DoRemote()
Case "SAVE"
	Call DoSave()
Case "LOCAL"
	Call DoLocal()
End Select
'Session.CodePage = Session("eWebEditor_Original_CodePage")

Sub InitUpload()
	sType = UCase(Trim(Request.QueryString("type")))
	sStyleName = Trim(Request.QueryString("style"))
	sCusDir = Trim(Request.QueryString("cusdir"))
	sCusDir = Replace(sCusDir, "\", "/")
	If Left(sCusDir, 1) = "/" Or Left(sCusDir, 1) = "." Or Right(sCusDir, 1) = "." Or InStr(sCusDir, "./") > 0 Or InStr(sCusDir, "/.") > 0 Or InStr(sCusDir, "//") > 0 Then
		sCusDir = ""
	End If
	Dim i, aStyleConfig, bValidStyle
	bValidStyle = False
	For i = 1 To Ubound(aStyle)
		aStyleConfig = Split(aStyle(i), "|||")
		If Lcase(sStyleName) = Lcase(aStyleConfig(0)) Then
			bValidStyle = True
			Exit For
		End If
	Next

	If bValidStyle = False Then
		OutScript("parent.UploadError('lang[""ErrInvalidStyle""]')")
	End If

	bOutUrl=false
	sBaseUrl = aStyleConfig(22)
	if sBaseUrl="3" then bOutUrl=true
	nUploadObject = Clng(aStyleConfig(18))
	nAutoDir = CLng(aStyleConfig(19))
	sUploadDir = aStyleConfig(23)
	If Left(sUploadDir, 1) <> "/" and sBaseUrl<>"3" Then
		sUploadDir = "../" & sUploadDir
	End If
	If Right(sUploadDir, 1) <> "/" Then
		sUploadDir =  sUploadDir& "/"
	End If

  '建立目录     
	Dim objFSO, sFolder

	If nAutoDir>0 Then
		sFolder = sType
	Else
		sFolder = ""
	End If
	
	Set objFSO = Server.CreateObject("Scripting.FileSystemObject")

	'5.5新增
	if bOutUrl then 
		tmpFileFolder=sUploadDir
	else
		tmpFileFolder=Server.MapPath(sUploadDir)
	end if
	If objFSO.FolderExists(tmpFileFolder) = False Then
		objFSO.CreateFolder(tmpFileFolder)
	End If
	If  objFSO.FolderExists(tmpFileFolder & sFolder) = False Then
		objFSO.CreateFolder(tmpFileFolder & sFolder)
	End If
	If  objFSO.FolderExists(tmpFileFolder&"small") = False Then
	 objFSO.CreateFolder(tmpFileFolder&"small")
	End If

	Select Case nAutoDir
		Case 0
			If sFolder = "" Then
				sAutoDir = ""
				sUploadDir = left(sUploadDir, InStrRev(LCase(sUploadDir), "/") - 1)
			Else
				sAutoDir = sFolder
				sUploadDir = sUploadDir & sAutoDir
			End If
		Case 1
			If sFolder <> "" Then sFolder = sFolder & "/"
			sAutoDir =  sFolder & Year(Now)
			sUploadDir =sUploadDir & sAutoDir
		Case 2
			If sFolder <> "" Then sFolder = sFolder & "/"
			sAutoDir = sFolder & FormatTime(Now, 6)
			sUploadDir =sUploadDir & sAutoDir
		Case 3
			If sFolder <> "" Then sFolder = sFolder & "/"
			sAutoDir = sFolder & FormatTime(Now, 2)
			sUploadDir =sUploadDir & sAutoDir
	End Select
	'5.5新增
	if bOutUrl then 
		tmpFileFolder=sUploadDir
	else
		tmpFileFolder=Server.MapPath(sUploadDir)
	end if
  
	If  objFSO.FolderExists(tmpFileFolder) = False Then
		objFSO.CreateFolder(tmpFileFolder)
	End If

	Set objFSO = Nothing
	'目录建立结束
	sUploadDir =sUploadDir & "/"
	If sAutoDir <> "" Then sAutoDir = sAutoDir & "/"
		
 
	Select Case sBaseUrl
	Case "0"
		sContentPath = aStyleConfig(25)&sAutoDir
	Case "1"
		sContentPath = RelativePath2RootPath(sUploadDir)
	Case "2"
		sContentPath = RootPath2DomainPath(RelativePath2RootPath(sUploadDir))
	Case "3"
		sContentPath = aStyleConfig(25)&sAutoDir
	End Select

	Select Case sType
	Case "REMOTE"
		sAllowExt = aStyleConfig(34)
		nAllowSize = Clng(aStyleConfig(35))
	Case "FILE"
		sAllowExt = aStyleConfig(32)
		nAllowSize = Clng(aStyleConfig(33))
	Case "MEDIA"
		sAllowExt = aStyleConfig(30)
		nAllowSize = Clng(aStyleConfig(31))
	Case "FLASH"
		sAllowExt = aStyleConfig(28)
		nAllowSize = Clng(aStyleConfig(29))
	Case Else
		sAllowExt = aStyleConfig(26)
		nAllowSize = Clng(aStyleConfig(27))
	End Select

		nSLTSYObject     = Clng(aStyleConfig(38))
		sSLTSYExt        = aStyleConfig(39)
		nSLTFlag         = Clng(aStyleConfig(40))
		nSLTMinSize      = Clng(aStyleConfig(41))
		nSLTOkSize       = Clng(aStyleConfig(42))
		nSYWZFlag        = Clng(aStyleConfig(43))
		nSYWZMinWidth    = Clng(aStyleConfig(44))
		nSYWZMinHeight   = Clng(aStyleConfig(45))
		sSYText          = aStyleConfig(46)
		sSYFontColor     = aStyleConfig(47)
		sSYShadowColor   = aStyleConfig(48)
		nSYShadowOffset  = Clng(aStyleConfig(49))
		nSYFontSize      = Clng(aStyleConfig(50))
		sSYFontName      = aStyleConfig(51)
		nSYWZPosition    = Clng(aStyleConfig(52))
		nSYWZpaddingh    = Clng(aStyleConfig(53))
		nSYWZpaddingv    = Clng(aStyleConfig(54))
		nSYWZtextWidth   = Clng(aStyleConfig(55))
		nSYWZtextHeight  = Clng(aStyleConfig(56))
		nSYTPFlag        = Clng(aStyleConfig(57))
		nSYTPMinWidth    = Clng(aStyleConfig(58))
		nSYTPMinHeight   = Clng(aStyleConfig(59))
		nSYTPPosition    = Clng(aStyleConfig(60))
		nSYTPPaddingh    = Clng(aStyleConfig(61))
		nSYTPPaddingv    = Clng(aStyleConfig(62))
		sSYPicPath       = aStyleConfig(63)
		nSYtpopacity     = Clng(aStyleConfig(64))
		nSYTPImageWidth  = Clng(aStyleConfig(65))
		nSYTPImageHeight = Clng(aStyleConfig(66))
		nCusDirFlag      = Clng(aStyleConfig(21))
End Sub


Sub DoSave()
	Response.Write "<html><head><title>eWebEditor</title><meta http-equiv='Content-Type' content='text/html; charset=utf-8'></head><body>"
	Select Case nUploadObject
	Case 1
		Call DoUpload_ASPUpload()
	Case 2
		Call DoUpload_SAFileUP()
	Case 3
		Call DoUpload_LyfUpload()
	Case Else
		Call DoUpload_Class()
	End Select

	Dim s_SmallImageFile, s_SmallImagePathFile, s_SmallImageScript
	s_SmallImagePathFile = ""
	s_SmallImageScript = ""
	s_SmallImageFile = getSmallImageFile(sSaveFileName)
	If makeImageSLT(sUploadDir, sSaveFileName, s_SmallImageFile) = True Then
		Call makeImageSY(sUploadDir, s_SmallImageFile)
		Call makeImageSY(sUploadDir, sSaveFileName)
		s_SmallImagePathFile = sContentPath &"small/"& s_SmallImageFile
		s_SmallImageScript = "try{obj.addUploadFile('" & sOriginalFileName & "', '" & s_SmallImageFile & "', '" & s_SmallImagePathFile & "');} catch(e){} "
	Else
		s_SmallImageFile = ""
		Call makeImageSY(sUploadDir, sSaveFileName)
	End If

	sPathFileName = sContentPath & sSaveFileName
	sOriginalFileName = Replace(sOriginalFileName, "'", "\'")
	sOriginalFileName = Replace(sOriginalFileName, """", "\""")

	Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments;if((!obj.eWebEditor)||(!obj.eWebEditor_Temp_HTML)||(!obj.eWebEditor_UploadForm)){obj=parent.dialogArguments.dialogArguments;} try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)
	'Call OutScript("parent.UploadSaved('" & sPathFileName & "','" & s_SmallImagePathFile & "');var obj=parent.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} " & s_SmallImageScript)
End Sub

Sub DoLocal()
	Select Case nUploadObject
	Case 1
		Call DoUpload_ASPUpload()
	Case 2
		Call DoUpload_SAFileUP()
	Case 3
		Call DoUpload_LyfUpload()
	Case Else
		Call DoUpload_Class()
	End Select
	sPathFileName = sContentPath & sSaveFileName
	response.Write(sPathFileName)
End Sub

Sub makeImageSY(s_Path, s_File)
	If nSYWZFlag = 0 And nSYTPFlag = 0 Then Exit Sub
	If isValidSLTSYExt(s_File) = False Then Exit Sub

	On Error Resume Next
	Dim nOriginalWidth, nOriginalHeight, posX, posY
	Dim oImage, oLogo
	'5.5新增
	if bOutUrl then 
		tmpFileFolder=s_Path
	else
		tmpFileFolder=Server.MapPath(s_Path)
	end if

	Select Case nSLTSYObject
	Case 0
		If IsObjInstalled("Persits.Jpeg") = False Then Exit Sub
		Set oImage = Server.CreateObject("Persits.Jpeg")

		If nSYWZFlag = 1 Then

			oImage.Open tmpFileFolder & s_File
			nOriginalWidth = oImage.OriginalWidth
			nOriginalHeight = oImage.OriginalHeight
			If nOriginalWidth<nSYWZMinWidth Or nOriginalHeight<nSYWZMinHeight Then Exit Sub
			posX = getSYPosX(nSYWZPosition, nOriginalWidth, nSYWZTextWidth+nSYShadowOffset, nSYWZPaddingH)
			posY = getSYPosY(nSYWZPosition, nOriginalHeight, nSYWZTextHeight+nSYShadowOffset, nSYWZPaddingV)

			oImage.Canvas.Font.Color = Clng("&H" & sSYFontColor)
			oImage.Canvas.Font.Family = sSYFontName
			'oImage.Canvas.Font.Bold = True
			oImage.Canvas.Font.Size = nSYFontSize
			oImage.Canvas.Font.ShadowColor = Clng("&H" & sSYShadowColor)
			oImage.Canvas.Font.ShadowXOffset = nSYShadowOffset
			oImage.Canvas.Font.ShadowYOffset = nSYShadowOffset
			oImage.Canvas.Print posX, posY, sSYText
			oImage.Save tmpFileFolder & s_File
		End If
		If nSYTPFlag = 1 Then
			oImage.Open tmpFileFolder & s_File
			nOriginalWidth = oImage.OriginalWidth
			nOriginalHeight = oImage.OriginalHeight
			If nOriginalWidth<nSYTPMinWidth Or nOriginalHeight<nSYTPMinHeight Then Exit Sub
			posX = getSYPosX(nSYTPPosition, nOriginalWidth, nSYTPImageWidth, nSYTPPaddingH)
			posY = getSYPosY(nSYTPPosition, nOriginalHeight, nSYTPImageHeight, nSYTPPaddingV)

			Set oLogo = Server.CreateObject("Persits.Jpeg")
			oLogo.Open Server.Mappath(sSYPicPath)
			oImage.DrawImage posX, posY, oLogo, nSYTPOpacity, &HFFFFFF
			oImage.Save tmpFileFolder & s_File
			Set oLogo = Nothing
		End If
		Set oImage = Nothing
	Case Else

	End Select

End Sub

Function getSYPosX(posFlag, originalW, syW, paddingH)
	Select Case posFlag
	Case 1, 2, 3
		getSYPosX = paddingH
	Case 4, 5, 6
		getSYPosX = (originalW - syW) \ 2
	Case 7, 8, 9
		getSYPosX = originalW - paddingH - syW
	End Select
End Function

Function getSYPosY(posFlag, originalH, syH, paddingV)
	Select Case posFlag
	Case 1, 4, 7
		getSYPosY = paddingV
	Case 2, 5, 8
		getSYPosY = (originalH - syH) \ 2
	Case 3, 6, 9
		getSYPosY = originalH - paddingV - syH
	End Select
End Function

Function makeImageSLT(s_Path, s_File, s_SmallFile)
	makeImageSLT = False
	If nSLTFlag = 0 Then Exit Function
	If isValidSLTSYExt(s_File) = False Then Exit Function

	Dim nOriginalWidth, nOriginalHeight, nWidth, nHeight
	Dim oImage
	'5.5新增
	if bOutUrl then 
		tmpFileFolder=s_Path
	else
		tmpFileFolder=Server.MapPath(s_Path)
	end if

	Select Case nSLTSYObject
	Case 0
		If IsObjInstalled("Persits.Jpeg") = False Then Exit Function
		Set oImage = Server.CreateObject("Persits.Jpeg")
		oImage.Open tmpFileFolder & s_File
		nOriginalWidth = oImage.OriginalWidth
		nOriginalHeight = oImage.OriginalHeight
		If nOriginalWidth < nSLTMinSize And nOriginalHeight < nSLTMinSize Then Exit Function
		If nOriginalWidth > nOriginalHeight Then
			nWidth = nSLTOkSize
			nHeight = (nSLTOkSize / nOriginalWidth) * nOriginalHeight
		Else
			nHeight = nSLTOkSize
			nWidth = (nSLTOkSize / nOriginalHeight) * nOriginalWidth
		End If
		oImage.Width = nWidth
		oImage.Height = nHeight
		oImage.Save tmpFileFolder & s_SmallFile
		Set oImage = Nothing
	Case Else

	End Select

	makeImageSLT = True
End Function

Function isValidSLTSYExt(s_File)
	Dim b, i, aExt, sExt
	b = False
	sExt = LCase(Mid(s_File, InstrRev(s_File, ".")+1))
	aExt = Split(LCase(sSLTSYExt), "|")
	For i = 0 To UBound(aExt)
		If aExt(i) = sExt Then
			b = True
			Exit For
		End If
	Next
	isValidSLTSYExt = b
End Function

Function getSmallImageFile(s_File)
	Dim n
	n = InstrRev(s_File, ".")
	getSmallImageFile = Left(s_File, n-1) & "_s." & Mid(s_File, n+1)
End Function


Sub DoRemote()
	Dim sContent, i
	For i = 1 To Request.Form("eWebEditor_UploadText").Count 
		sContent = sContent & Request.Form("eWebEditor_UploadText")(i) 
	Next
	If sAllowExt <> "" Then
		sContent = ReplaceRemoteUrl(sContent, sAllowExt)
	End If

	Response.Write "<HTML><HEAD><TITLE>eWebEditor</TITLE><meta http-equiv='Content-Type' content='text/html; charset=utf-8'></head><body>" & _
		"<input type=hidden id=UploadText value=""" & inHTML(sContent) & """>" & _
		"</body></html>"

	Call OutScriptNoBack("parent.setHTML(UploadText.value);try{parent.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} parent.remoteUploadOK();")

End Sub

Sub DoCreateNewDir()
	Dim a, i
	If nCusDirFlag = 1 Then
		a = Split(sCusDir, "/")
		For i = 0 To UBound(a)
			If a(i) <> "" Then
				Call CreateFolder(a(i))
			End If
		Next
	End If

	Dim s_DateDir
	Select Case nAutoDir
	Case 1
		s_DateDir = Left(FormatTime(Now(), 4), 4)
	Case 2
		s_DateDir = Left(FormatTime(Now(), 4), 6)
	Case 3
		s_DateDir = Left(FormatTime(Now(), 4), 8)
	Case Else
		s_DateDir = ""
	End Select
	If s_DateDir <> "" Then
		Call CreateFolder(s_DateDir)
	End If
End Sub

Sub CreateFolder(s_Folder)
	If IsObjInstalled("Scripting.FileSystemObject") = False Then
		Exit Sub
	End If

	sUploadDir = sUploadDir & s_Folder & "/"
	sContentPath = sContentPath & s_Folder & "/"

	Dim fso
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	If fso.FolderExists(Server.Mappath(sUploadDir)) = False Then
		fso.CreateFolder Server.Mappath(sUploadDir)
	End If
	Set fso = Nothing
End Sub

Sub DoUpload_LyfUpload()
	On Error Resume Next
	Dim oUpload, sResult, sOriginalFile
	Set oUpload = Server.CreateObject("LyfUpload.UploadFile")
	oUpload.CodePage = 936
	oUpload.ExtName = Replace(sAllowExt, "|", ",")
	oUpload.MaxSize = nAllowSize*1024
	sOriginalFile = oUpload.Request("originalfile")
	sOriginalFileName = Mid(sOriginalFile, InStrRev(sOriginalFile, "\") + 1)
	sFileExt = LCase(Mid(sOriginalFileName, InStrRev(sOriginalFileName, ".") + 1))
	Call CheckValidExt(sFileExt)
	sSaveFileName = GetRndFileName(sFileExt)
	'5.5新增
	if bOutUrl then 
		tmpFileFolder=sUploadDir
	else
		tmpFileFolder=Server.MapPath(sUploadDir)
	end if

	sResult = oUpload.SaveFile("uploadfile", tmpFileFolder, True, sSaveFileName)

	Select Case sResult
	Case "0"
		Call OutScript("parent.UploadError('size')")
	Case ""
		Call OutScript("parent.UploadError('file')")
	Case "1"
		Call OutScript("parent.UploadError('ext')")
	End Select
	
	Set oUpload = Nothing
End Sub

Sub DoUpload_SAFileUp()
	On Error Resume Next
	Dim oFileUp
	Set oFileUp = Server.CreateObject("SoftArtisans.FileUp")
	'oFileUp.MaxBytes = nAllowSize*1024
	oFileUp.CodePage = 936
	'5.5新增
	if bOutUrl then 
		tmpFileFolder=sUploadDir
	else
		tmpFileFolder=Server.MapPath(sUploadDir)
	end if

	If oFileUp.Form("uploadfile").TotalBytes > nAllowSize*1024 Then
		Err.Clear
		Call OutScript("parent.UploadError('size')")
	End If
	If oFileUp.Form("uploadfile").IsEmpty Then
		Call OutScript("parent.UploadError('file')")
	End If

	Dim sShortFileName
	'sShortFileName = oFileUp.Form("uploadfile").ShortFileName
	sShortFileName = Mid(oFileUp.Form("uploadfile").UserFilename, InstrRev(oFileUp.Form("uploadfile").UserFilename, "\") + 1)

	sFileExt = LCase(Mid(sShortFileName, InStrRev(sShortFileName, ".") + 1))
	Call CheckValidExt(sFileExt)
	sOriginalFileName = sShortFileName
	sSaveFileName = GetRndFileName(sFileExt)
	oFileUp.Form("uploadfile").SaveAs tmpFileFolder & sSaveFileName
	
	Set oFileUp = Nothing
End Sub

Sub DoUpload_ASPUpload()
	On Error Resume Next
	Dim oUpload, oFile, nCount
	Set oUpload = Server.CreateObject("Persits.Upload")
	oUpload.CodePage = 936
	oUpload.SetMaxSize nAllowSize*1024, True
	nCount = oUpload.Save
	'nCount = oUpload.SaveToMemory

	'5.5新增
	if bOutUrl then 
		tmpFileFolder=sUploadDir
	else
		tmpFileFolder=Server.MapPath(sUploadDir)
	end if

	
	If nCount < 1 Then
		Call OutScript("parent.UploadError('file')")
	End If
	If Err.Number = 8 Then
		Err.Clear
		Call OutScript("parent.UploadError('size')")
	End If
	
	Set oFile = oUpload.Files("uploadfile")
	sFileExt = LCase(Mid(oFile.Ext, 2))
	Call CheckValidExt(sFileExt)
	sOriginalFileName = oFile.FileName
	sSaveFileName = GetRndFileName(sFileExt)
	oFile.SaveAs tmpFileFolder & sSaveFileName

	Set oFile = Nothing
	Set oUpload = Nothing
End Sub

Sub DoUpload_Class()
	On Error Resume Next
	Dim oUpload, oFile
	Set oUpload = New upfile_class

	oUpload.GetData nAllowSize*1024

	If oUpload.Err > 0 Then
		Select Case oUpload.Err
		Case 1
			Call OutScript("parent.UploadError('lang[""ErrUploadInvalidFile""]')")
		Case 2
			Call OutScript("parent.UploadError('lang[""ErrUploadSizeLimit""]+"":" & nAllowSize & "KB""')")
		End Select
	End If

	Set oFile = oUpload.File("uploadfile")
	sFileExt = LCase(trim(oFile.FileExt))
	Call CheckValidExt(sFileExt)
	sOriginalFileName = oFile.FileName
	sSaveFileName = GetRndFileName(sFileExt)

	Dim str_Mappath
	'5.5 add
	if bOutUrl then 
		str_Mappath=sUploadDir & sSaveFileName
	else
		str_Mappath = Server.Mappath(sUploadDir & sSaveFileName)
	end if
	sFileExt = LCase(Mid(str_Mappath, InstrRev(str_Mappath, ".") + 1))
	Call CheckValidExt(sFileExt)

	oFile.SaveToFile str_Mappath
	Set oFile = Nothing
	Set oUpload = Nothing
	
End Sub

Function GetRndFileName(sExt)
	Dim sRnd
	Randomize
	sRnd = Int(900 * Rnd) + 100
	GetRndFileName = FormatTime(Now(), 5) & sRnd & "." & sExt
End Function

Sub OutScript(str)
	If sAction <> "LOCAL" Then
		Response.Write "<script language=javascript>" & str & ";history.back()</script>"
		'Session.CodePage = Session("eWebEditor_Original_CodePage")
	End If
	Response.End	
End Sub

Sub OutScriptNoBack(str)
	Response.Write "<script language=javascript>" & str & "</script>"
End Sub

Sub CheckValidExt(sExt)
	Dim b, i, aExt
	b = False
	aExt = Split(sAllowExt, "|")
	For i = 0 To UBound(aExt)
		If LCase(aExt(i)) = sExt Then
			b = True
			Exit For
		End If
	Next
	If b = False Then
		Call OutScript("parent.UploadError('lang[""ErrUploadInvalidExt""]+"":" & sAllowExt & """')")
	End If
End Sub


Function RelativePath2RootPath(url)
	Dim sTempUrl
	sTempUrl = url
	If Left(sTempUrl, 1) = "/" Then
		RelativePath2RootPath = sTempUrl
		Exit Function
	End If

	Dim sWebEditorPath
	sWebEditorPath = Request.ServerVariables("SCRIPT_NAME")
	sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
	Do While Left(sTempUrl, 3) = "../"
		sTempUrl = Mid(sTempUrl, 4)
		sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
	Loop
	RelativePath2RootPath = sWebEditorPath & "/" & sTempUrl
End Function

Function RootPath2DomainPath(url)
	Dim sHost, sPort
	sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
	sPort = Request.ServerVariables("SERVER_PORT")
	If sPort <> "80" Then
		sHost = sHost & ":" & sPort
	End If
	RootPath2DomainPath = sHost & url
End Function

Function ReplaceRemoteUrl(sHTML, sExt)
	Dim s_Content
	s_Content = sHTML
	If IsObjInstalled("Microsoft.XMLHTTP") = False then
		ReplaceRemoteUrl = s_Content
		Exit Function
	End If
	
	Dim re, RemoteFile, RemoteFileurl, SaveFileName, SaveFileType
	Set re = new RegExp
	re.IgnoreCase  = True
	re.Global = True
	're.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([A-Za-z0-9_-])+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})([^ \f\n\r\t\v\""\'\>]*\/)(([^ \f\n\r\t\v\""\'\>])+[.]{1}(" & sExt & ")))"
	re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([A-Za-z0-9_-])+[.]){1,}([A-Za-z0-9]{1,5})\/(\S+\.(" & sExt & ")))"


	Set RemoteFile = re.Execute(s_Content)
	Dim a_RemoteUrl(), n, i, bRepeat
	n = 0
	' to no repeat array    
	For Each RemoteFileurl in RemoteFile
		If n = 0 Then
			n = n + 1
			Redim a_RemoteUrl(n)
			a_RemoteUrl(n) = RemoteFileurl
		Else
			bRepeat = False
			For i = 1 To UBound(a_RemoteUrl)
				If UCase(RemoteFileurl) = UCase(a_RemoteUrl(i)) Then
					bRepeat = True
					Exit For
				End If
			Next
			If bRepeat = False Then
				n = n + 1
				Redim Preserve a_RemoteUrl(n)
				a_RemoteUrl(n) = RemoteFileurl
			End If
		End If		
	Next
	' start replace 
	nFileNum = 0
	For i = 1 To n
		SaveFileType = Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), ".") + 1)
		SaveFileName = GetRndFileName(SaveFileType)
		If SaveRemoteFile(SaveFileName, a_RemoteUrl(i)) = True Then
			nFileNum = nFileNum + 1
			If nFileNum > 0 Then
				sOriginalFileName = sOriginalFileName & "|"
				sSaveFileName = sSaveFileName & "|"
				sPathFileName = sPathFileName & "|"
			End If
			sOriginalFileName = sOriginalFileName & Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), "/") + 1)
			sSaveFileName = sSaveFileName & SaveFileName
			sPathFileName = sPathFileName & sContentPath & SaveFileName
			s_Content = Replace(s_Content, a_RemoteUrl(i), sContentPath & SaveFileName, 1, -1, 1)
		End If
	Next

	ReplaceRemoteUrl = s_Content
End Function


Function SaveRemoteFile(s_LocalFileName, s_RemoteFileUrl)
	Dim Ads, Retrieval, GetRemoteData
	Dim bError
	bError = False
	SaveRemoteFile = False
	On Error Resume Next
	Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
	With Retrieval
		.Open "Get", s_RemoteFileUrl, False, "", ""
		.Send
		GetRemoteData = .ResponseBody
	End With
	Set Retrieval = Nothing

	If LenB(GetRemoteData) > nAllowSize*1024 Then
		bError = True
	Else
		Set Ads = Server.CreateObject("Adodb." & "Stream")
		With Ads
			.Type = 1
			.Open
			.Write GetRemoteData
			.SaveToFile Server.MapPath(sUploadDir & s_LocalFileName), 2
			.Cancel()
			.Close()
		End With
		Set Ads=nothing
	End If

	If Err.Number = 0 And bError = False Then
		SaveRemoteFile = True
	Else
		Err.Clear
	End If
End Function



Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)
	If 0 = Err Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function

Function inHTML(str)
	Dim sTemp
	sTemp = str
	inHTML = ""
	If IsNull(sTemp) = True Then
		Exit Function
	End If
	sTemp = Replace(sTemp, "&", "&amp;")
	sTemp = Replace(sTemp, "<", "&lt;")
	sTemp = Replace(sTemp, ">", "&gt;")
	sTemp = Replace(sTemp, Chr(34), "&quot;")
	inHTML = sTemp
End Function

Function FormatTime(s_Time, n_Flag)
	Dim y, m, d, h, mi, s
	FormatTime = ""
	If IsDate(s_Time) = False Then Exit Function
	y = cstr(year(s_Time))
	m = cstr(month(s_Time))
	If len(m) = 1 Then m = "0" & m
	d = cstr(day(s_Time))
	If len(d) = 1 Then d = "0" & d
	h = cstr(hour(s_Time))
	If len(h) = 1 Then h = "0" & h
	mi = cstr(minute(s_Time))
	If len(mi) = 1 Then mi = "0" & mi
	s = cstr(second(s_Time))
	If len(s) = 1 Then s = "0" & s
	Select Case n_Flag
	Case 1
		FormatTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
	Case 2
		FormatTime = y & "-" & m & "-" & d
	Case 3
		FormatTime = h & ":" & mi & ":" & s
	Case 4
		FormatTime = y & m & d
	Case 5
		FormatTime = y & m & d & h & mi & s
	End Select
End Function

%>